home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 51 / Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso / -in_the_mag- / banging_the_metal / demo / charmode_bas < prev    next >
Text File  |  2000-01-14  |  14KB  |  349 lines
  1. 100 REMark Custom Amiga Qdos character-mapped screens
  2. 110 REMark 2345678901234567890123456789012345678901234567890123456789012345678901234
  3. 120 SCR_PRIORITY 4,1 :REMark Priority of Qdos, not custom, screen
  4. 130 REMark OCS 15KHz demonstration version 0.16, SNG January 2000
  5. 140 WINDOW #2,512,200,0,0 : MODE 4 : CSIZE #0,2,0
  6. 150 custom=HEX("DFF000")
  7. 160 pagesize=2^16
  8. 170 chipspace=pagesize*3 :REMark Make sure we get two complete pages
  9. 180 REMark All structures start in one 64K page (xx0000) so that we only need
  10. 190 REMark to vary the low pointer words to move them. The Copper list may
  11. 200 REMark extend to a second page if thousands of characters are in use.
  12. 210 HeadLines%=60 :REMark Pixel lines at top of screen above character map area
  13. 220 CharHeight%=16 :REMark 1..16, 10=Qdos, 12=TRS-80, 8=PET
  14. 230 CharLines%=12 : CharColumns%=40 :REMark 32/40/64/80; ALWAYS CharWidth%=8
  15. 240 BlitFount=(CharHeight%=8 AND CharColumns%<=40) :REMark Set for 8x8 fount update
  16. 250 BlitChars=(CharColumns%<=40) :REMark Unpack CharMap each LoRes field
  17. 260 ShowTime=1 :REMark Set this flag for traditional stripes showing blitter phases
  18. 270 lines%=HeadLines%+CharLines%*CharHeight%
  19. 280 IF lines%<192 THEN PRINT"Too few lines for OCS! - add HeadLines!":STOP
  20. 290 IF lines%>287 THEN PRINT #0;"Too many lines for PAL!":STOP
  21. 300 width%=CharColumns% :REMark Bytes per line per bitplane (EVEN!)
  22. 310 last_sprite%=0 :REMark This one doesn't use sprites at all
  23. 320 IF width% && 1 : PRINT #0;"Uneven bitplane width": STOP
  24. 330 REMark At least 64 pixels fetched are masked by scrolling
  25. 340 border%=0/4 :REMark Extra bytes per line, 8..24, for scrolling
  26. 350 IF border% && 1 : PRINT #0;"Uneven bitplane border": STOP
  27. 360 left_edge%=152+8*last_sprite% :REMark Low resolution pixels
  28. 370 IF (CharColumns% MOD 40)=0 THEN left_edge%=left_edge%-40
  29. 380 IF CharColumns%=32 THEN left_edge%=left_edge%-20
  30. 390 top_line%=312-lines% :REMark 64 for 192 lines? CBM 1960 range is 26+
  31. 400 IF top_line%>64 THEN LET top_line%=64 :REMark Stay near top of screen
  32. 410 PRINT #0;"Total"!border%+width%!"bytes per pixel line"
  33. 420 DMACON_R=2
  34. 430 COPCON=46
  35. 440 BLTCON0=64
  36. 450 BLTCON1=66
  37. 460 BLTMASK=68
  38. 470 BLTBPT=76
  39. 480 BLTAPT=80
  40. 490 BLTDPT=84
  41. 500 BLTSIZE=88
  42. 510 BLTBMOD=98
  43. 520 BLTAMOD=100
  44. 530 BLTDMOD=102
  45. 540 BLTCDAT=112
  46. 550 COP1LC=HEX("80")
  47. 560 DIWSTART=HEX("8E")
  48. 570 DIWSTOP=HEX("90")
  49. 580 DDFSTART=HEX("92")
  50. 590 DDFSTOP=HEX("94")
  51. 600 DMACON_W=HEX("96")
  52. 610 BPL1PT=HEX("E0")
  53. 620 BPLCON0=HEX("100")
  54. 630 BPLCON1=HEX("102")
  55. 640 BPLCON2=HEX("104")
  56. 650 BPLCON3=HEX("106")
  57. 660 BPL1MOD=HEX("108")
  58. 670 BPL2MOD=HEX("10A")
  59. 680 SPR0PTH=HEX("120")
  60. 690 SPR0PTL=HEX("122")
  61. 700 COLOUR0=HEX("180")
  62. 710 COLOUR17=HEX("1A2")
  63. 720 COLOUR18=HEX("1A4")
  64. 730 COLOUR19=HEX("1A6")
  65. 740 COLOUR1=HEX("182")
  66. 750 HTOTAL=HEX("1C0")
  67. 760 HSSTOP=HEX("1C2")
  68. 770 HBSTART=HEX("1C4")
  69. 780 HBSTOP=HEX("1C6")
  70. 790 VTOTAL=HEX("1C8")
  71. 800 VSSTOP=HEX("1CA")
  72. 810 VBSTART=HEX("1CC")
  73. 820 VBSTOP=HEX("1CE")
  74. 830 BEAMCON0=HEX("1DC")
  75. 840 HSSTART=HEX("1DE")
  76. 850 VSSTART=HEX("1E0")
  77. 860 HCENTRE=HEX("1E2")
  78. 870 DIWHIGH=HEX("1E4")
  79. 880 FMODE=HEX("1FC")
  80. 890 :
  81. 900 REMark Errors must return to Qdos mode
  82. 910 ql_off=0
  83. 920 WHEN ERRor 
  84. 930 IF ql_off : QL_ON
  85. 940 PRINT #0;"At ";ERLIN; : REPORT
  86. 950 STOP
  87. 960 END WHEN 
  88. 970 :
  89. 980 CLCHP
  90. 990 cpu_blit=0 :REMark Clear for COPPER_BLITs
  91. 1000 MAKE_CLIST
  92. 1010 BLIT_OFF : PAUSE 10
  93. 1020 screen=backdrop
  94. 1030 POKE_W COPCON+custom,2*(NOT cpu_blit) :REMark Allow Copper to Blit
  95. 1050 CUSTOM_ON
  96. 1060 i=0
  97. 1070 REPeat poll
  98. 1080   IF INKEY$(#0,1)<>"" : EXIT poll
  99. 1090   i=((i+2) && 254)
  100. 1100   POKE$ CharMap,FILL$(CHR$(i),CharLines%*CharColumns%)
  101. 1110 END REPeat poll
  102. 1120 QL_ON
  103. 1130 STOP
  104. 1140 :
  105. 1150 REMark Copper list codegen PROCs
  106. 1160 :
  107. 1170 DEFine PROCedure MOVE(value%,reg%)
  108. 1180 POKE_W copper,reg%
  109. 1190 POKE_W copper+2,value%
  110. 1200 copper=copper+4
  111. 1210 END DEFine MOVE
  112. 1220 :
  113. 1230 DEFine PROCedure WAIT(x%,y%)
  114. 1240 POKE_W copper,(y% && 255)*256+(x% && 254)+1
  115. 1250 POKE_W copper+2,32766 :REMark Blitter wait & use all X/Y bits
  116. 1260 copper=copper+4
  117. 1270 END DEFine WAIT
  118. 1280 :
  119. 1290 DEFine PROCedure SKIP(x%,y%)
  120. 1300 POKE_W copper,(y% && 255)*256+(x% && 254)+1
  121. 1310 POKE_W copper+2,32767 :REMark Blitter wait & use all X/Y bits
  122. 1320 copper=copper+4
  123. 1330 END DEFine SKIP
  124. 1340 :
  125. 1350 DEFine PROCedure MAKE_CLIST
  126. 1360 LOCal y,sp :REMark Creates lots of globals
  127. 1370 base=ALCHP(chipspace)
  128. 1380 IF base<1 OR base+chipspace>=2^21
  129. 1390   IF base>0 : RECHP base
  130. 1400   PRINT #0;"Required Chip RAM not found!" : STOP
  131. 1410 END IF 
  132. 1420 page=INT(base/pagesize)+1
  133. 1430 pagebase=page*pagesize : backdrop=pagebase+8192 :REMark Obsolete?
  134. 1440 line_length%=width%+border%
  135. 1450 fount_low=0 : Plane=pagebase+8192 : CharMap=Plane+line_length%*lines%+128
  136. 1460 fount=fount_low+pagebase
  137. 1470 PRINT #0;"Loading fount for character height ";CharHeight%
  138. 1480 LOAD_FOUNT
  139. 1490 INK #2,7 : PAPER #2,0 : CLS #2 : LIST 100 TO 200
  140. 1510 QDOS2 Plane
  141. 1520 :
  142. 1530 REMark Ensure line alignment, then make the actual copper list
  143. 1540 copper=CharMap+CharColumns%*CharLines%
  144. 1550 copper=16+INT(copper/16)*16
  145. 1560 clist=copper
  146. 1570 PRINT #0;"Setting up copper list ";
  147. 1580 MOVE #page TO BPL1PT
  148. 1590 MOVE #page TO BLTAPT
  149. 1600 MOVE #page TO BLTBPT
  150. 1610 MOVE #page TO BLTDPT
  151. 1620 MOVE #8192 TO BPL1PT+2
  152. 1630 IF CharColumns%>40
  153. 1640   MOVE #HEX("9200") TO BPLCON0 :REMark Hires Colour, 1 bitplane
  154. 1650 ELSE 
  155. 1660   MOVE #HEX("1200") TO BPLCON0 :REMark LoRes Colour, one plane
  156. 1670 END IF 
  157. 1680 MOVE #0 TO BPLCON3 :REMark No special AGA tricks
  158. 1690 MOVE #0 TO COLOUR0 :REMark Black background
  159. 1700 MOVE #HEX("0CC5") TO COLOUR1 : REMark Bright yellow foreground
  160. 1710 MOVE #top_line%*256+left_edge% TO DIWSTART :REMark True left limit
  161. 1720 IF CharColumns%>40
  162. 1730   MOVE #(top_line%+lines%)*256+left_edge%+width%*4+8 TO DIWSTOP
  163. 1740 ELSE 
  164. 1745   zap=copper+2 :REMark Next line is dodgy and may need correction
  165. 1750   MOVE #(top_line%+lines%)*256+(255 && (left_edge%+width%*8+16)) TO DIWSTOP
  166. 1755   IF CharColumns%=32 THEN POKE zap+1,164 :REMark Bodge!
  167. 1760 END IF 
  168. 1770 MOVE #left_edge% DIV 2 TO DDFSTART :REMark Hardware stop is at 18
  169. 1780 IF CharColumns%>40
  170. 1790   MOVE #(left_edge% DIV 2)+4*(width% DIV 2)-8 TO DDFSTOP :REMark Limit 204
  171. 1800 ELSE 
  172. 1810   MOVE #(left_edge% DIV 2)+4*width%-8 TO DDFSTOP :REMark Limit 204
  173. 1820 END IF 
  174. 1830 MOVE #HEX("2100") TO DIWHIGH  :REMark Set H8 and V8 (ECS only!)
  175. 1840 MOVE #0 TO BPL1MOD
  176. 1850 IF NOT cpu_blit THEN MAKE_COPPER_BLITS
  177. 1860 WAIT 255,255
  178. 1870 WAIT 255,255 :REMark Braces
  179. 1880 END DEFine MAKE_CLIST
  180. 1890 :
  181. 1900 DEFine PROCedure QL_ON
  182. 1910 POKE_W custom+DMACON_W,1024
  183. 1920 POKE_W custom+DMACON_W,32768+ql_dmacon
  184. 1930 POKE_L custom+COP1LC,HEX("18600")
  185. 1940 PAUSE 1
  186. 1950 POKE_W custom+COLOUR0,0
  187. 1960 POKE_W custom+COLOUR1,15 :REMark *256 for red
  188. 1970 BLIT_ON : ql_off=0
  189. 1980 END DEFine QL_ON
  190. 1990 :
  191. 2000 DEFine PROCedure CUSTOM_ON
  192. 2010 BLIT_OFF
  193. 2020 ql_off=1
  194. 2030 PAUSE 1
  195. 2040 ql_dmacon=PEEK_W(custom+DMACON_R)
  196. 2050 POKE_L custom+COP1LC,clist
  197. 2060 PAUSE 1
  198. 2070 POKE_W custom+DMACON_W,32 :REMark No sprites
  199. 2080 END DEFine CUSTOM_ON
  200. 2090 :
  201. 2100 DEFine PROCedure QDOS2(bitmap)
  202. 2110 REMark Test routine to throw a Qdos screen into a custom bitplane
  203. 2120 LOCal win_height,win_width,win_base,y :REMark GLOBAL line_length%
  204. 2130 win_height=lines%-1 :REMark Lines numbered from 0
  205. 2140 IF win_height>129 THEN win_height=129
  206. 2150 win_width =64 :REMark Bytes
  207. 2160 PRINT #0;"Copying Qdos window ";win_width*8;"x";win_height+1
  208. 2170 win_base=65536 :REMark Amiga bitplane of Qdos Screen
  209. 2180 FOR y=0 TO win_height
  210. 2190   POKE$ bitmap+y*line_length%,PEEK$(win_base,win_width)
  211. 2200   win_base=win_base+win_width
  212. 2210 END FOR y
  213. 2220 END DEFine QDOS2
  214. 2230 :
  215. 2240 DEFine PROCedure BLIT_CHAR
  216. 2250 IF BlitFount THEN charGap=16 : ELSE charGap=32
  217. 2260 MOVE #fount_low+66*charGap TO BLTBPT+2
  218. 2270 MOVE #fount_low+97*charGap TO BLTAPT+2
  219. 2280 MOVE #N TO BLTDPT+2 : N=N+2
  220. 2290 MOVE #1+CharHeight%*64 TO BLTSIZE
  221. 2300 WAIT COL,LIN :REMark Effectively WaitBlit
  222. 2310 COL=COL+GAP : IF COL>225 THEN COL=COL-226 : LIN=LIN+1
  223. 2320 END DEFine BLIT_CHAR
  224. 2330 :
  225. 2340 DEFine PROCedure SEE
  226. 2350 CUSTOM_ON
  227. 2360 PAUSE
  228. 2370 QL_ON
  229. 2380 END DEFine SEE
  230. 2390 :
  231. 2400 DEFine PROCedure S
  232. 2410 SAVE_O flp1_charmode_bas
  233. 2420 END DEFine S
  234. 2430 :
  235. 2440 DEFine PROCedure LOAD_FOUNT
  236. 2450 REMark fount=ALCHP(256*16*2)
  237. 2460 IF fount>0 AND fount<2^21
  238. 2470   IF BlitFount=0
  239. 2480     REMark 256 characters, 16x16 bit patterns (justify top left)
  240. 2490     IF CharHeight%=16
  241. 2500       LBYTES flp1_Unpacked16x16_fount,fount
  242. 2510     ELSE 
  243. 2520       LBYTES flp1_Unpacked16x9_fount,fount
  244. 2530     END IF 
  245. 2540   ELSE 
  246. 2550     LBYTES flp1_Packed8x8_fount,fount+4096
  247. 2560     REMark 256 characters, 8x8 for expansion
  248. 2570 ELSE 
  249. 2580   PRINT #0;"No chip RAM for fount!"
  250. 2590   STOP
  251. 2600 END IF 
  252. 2610 END DEFine LOAD_FOUNT
  253. 3040 :
  254. 3050 DEFine PROCedure EXPAND_FOUNT(a,b,c)
  255. 3060 REMark Expand 8x8 fount at A to 16x8 fount at B for C characters
  256. 3070 REMark A and B are offsets in the page, C is a WORD count
  257. 3080 IF ShowTime THEN MOVE #6*256 TO COLOUR0 :REMark Signal start of pass 1
  258. 3090 MOVE #HEX("09A0") TO BLTCON0 :REMark D := A & C (constant)
  259. 3100 MOVE #0 TO BLTCON1 :REMark Ascending pass
  260. 3110 MOVE #-1 TO BLTMASK :REMark Use all bits in first word
  261. 3120 MOVE #-1 TO BLTMASK+2 :REMark Last word, use all bits
  262. 3130 MOVE #0 TO BLTAMOD :REMark Source modulo
  263. 3140 MOVE #2 TO BLTDMOD :REMark Destination modulo
  264. 3150 MOVE #HEX("FF00") TO BLTCDAT :REMark Byte mask
  265. 3160 MOVE #a TO BLTAPT+2 :REMark Source
  266. 3170 MOVE #b TO BLTDPT+2 :REMark Destination
  267. 3180 MOVE #1024 TO DMACON_W :REMark Not Nasty (yet)
  268. 3190 MOVE #c*64+1 TO BLTSIZE
  269. 3200 WAIT 0,0
  270. 3210 IF ShowTime THEN MOVE #HEX("608") TO COLOUR0
  271. 3220 MOVE #2 TO BLTCON1 :REMark DESCENDING pass
  272. 3230 MOVE #a+2046 TO BLTAPT+2 :REMark Source
  273. 3240 MOVE #b+4094 TO BLTDPT+2 :REMark Destination
  274. 3250 MOVE #HEX("89A0") TO BLTCON0 :REMark D := (A * 256) & C
  275. 3260 MOVE #c*64+1 TO BLTSIZE
  276. 3270 WAIT 0,0 :REMark Wait for Blit to finish
  277. 3280 MOVE #page TO BLTDPT :REMark Stay in our page
  278. 3290 MOVE #page TO BLTAPT :REMark Stay in our page
  279. 3300 END DEFine EXPAND_FOUNT
  280. 3310 :
  281. 3320 DEFine PROCedure SETUP_CHAR_BLITS
  282. 3330 IF ShowTime THEN MOVE #5 TO COLOUR0 :REMark Blue during blitting
  283. 3340 IF CharColumns%>40 :MOVE #32768+1024 TO DMACON_W :REMark Get Nasty
  284. 3350 REMark Get set for Character blits
  285. 3360 MOVE #HEX("0DFC") TO BLTCON0 :REMark D := A v B for characters
  286. 3370 MOVE #HEX("8000") TO BLTCON1 :REMark B shift for characters
  287. 3380 MOVE #0 TO BLTBMOD
  288. 3390 MOVE #0 TO BLTAMOD
  289. 3400 MOVE #width%-2 TO BLTDMOD
  290. 3410 END DEFine SETUP_CHAR_BLITS
  291. 3420 :
  292. 3430 DEFine PROCedure MAKE_COPPER_BLITS
  293. 3440 REMark Generate copper list to unpack CharMap and Fount, and blit characters
  294. 3450 REMark Work out start line LIN, staying ahead of the beam
  295. 3460 LIN=top_line%+HeadLines%-CharHeight%-(CharHeight%=8)*((CharLines%+3) DIV 4)
  296. 3470 REMark Allow one extra scan per 32 for short characters, to stay ahead of beam
  297. 3480 IF BlitChars :LIN=LIN-((CharColumns%*CharLines%) DIV 80):REMark Bytes -> CLIST
  298. 3490 IF BlitFount :LIN=LIN-28 :REMark Allow time to unpack 2K fount to 4K
  299. 3500 IF CharColumns%>64 THEN LIN=LIN-CharLines%*2 :REMark Time to unpack CharMap
  300. 3510 WAIT 0,LIN : PRINT #0;"for line ";
  301. 3520 IF LIN<1 THEN PRINT #0;"No time - add HeadLines% if possible." : STOP
  302. 3530 t=CharHeight% :REMark Compute WAIT period between character blits
  303. 3540 SELect ON t:=9 TO 11:GAP=70:=12 TO 16:GAP=t*2+60:=1 TO 8:GAP=58
  304. 3550 IF CharColumns%>64 THEN GAP=GAP-4*(t>8)-2*(t>11):REMark Cut gap, more columns
  305. 3560 COL=GAP:TextLineBytes%=CharColumns%*CharHeight%:Start%=HeadLines%*width%+8192
  306. 3570 IF BlitChars THEN CHARS_TO_CLIST CharMap,CharColumns%*CharLines%
  307. 3580 IF CharColumns%<=40 : GAP=GAP*3/4 :REMark Not Nasty
  308. 3590 IF BlitFount THEN EXPAND_FOUNT fount+4096,fount,1024 :LIN=LIN+28
  309. 3600 SETUP_CHAR_BLITS :REMark Set Blitter registers the same for every character
  310. 3610 IF BlitChars:POKE_W FirstCharMove,copper-pagebase+6 :REMark First channel A ptr
  311. 3620 FOR textline=Start% TO Start%+TextLineBytes%*(CharLines%-1) STEP TextLineBytes%
  312. 3630   N=textline : AT #0,3,32 : PRINT #0,1+(N-Start%) DIV TextLineBytes%;
  313. 3640   FOR i=1 TO CharColumns% DIV 2 : BLIT_CHAR
  314. 3650 END FOR textline
  315. 3660 IF BlitChars:POKE_W LastCharMove,copper-pagebase-18 :REMark Last B word ptr
  316. 3670 IF ShowTime THEN MOVE #0 TO COLOUR0
  317. 3680 END DEFine MAKE_COPPER_BLITS
  318. 3690 :
  319. 3700 DEFine PROCedure CHARS_TO_CLIST(a,c)
  320. 3710 REMark Expand character code bytes at A to Copper list for C characters
  321. 3720 IF ShowTime THEN MOVE #112 TO COLOUR0 :REMark Signal start of pass 1
  322. 3730 IF CharHeight%=8
  323. 3740   MOVE #HEX("0FF0") TO BLTCDAT :REMark Byte mask for *16
  324. 3750   MOVE #HEX("49A0") TO BLTCON0 :REMark D := (A >> 4) & C (constant)
  325. 3760 ELSE 
  326. 3770   MOVE #HEX("1FE0") TO BLTCDAT :REMark CharCode *32
  327. 3780   MOVE #HEX("39A0") TO BLTCON0 :REMark D := (A >> 3) & C (constant)
  328. 3790 END IF 
  329. 3800 MOVE #0 TO BLTCON1 :REMark Ascending pass
  330. 3810 MOVE #-1 TO BLTMASK :REMark Use all bits in first word
  331. 3820 MOVE #-1 TO BLTMASK+2 :REMark Last word, use all bits
  332. 3830 MOVE #0 TO BLTAMOD :REMark Source modulo
  333. 3840 MOVE #18 TO BLTDMOD :REMark Destination modulo
  334. 3850 MOVE #a TO BLTAPT+2 :REMark Source
  335. 3860 MOVE #0 TO BLTDPT+2 :REMark Destination
  336. 3870 FirstCharMove=copper-2 :REMark Where to POKE later
  337. 3880 MOVE #1024 TO DMACON_W :REMark Not Nasty (yet)
  338. 3890 MOVE #c*32+1 TO BLTSIZE
  339. 3900 WAIT 0,0
  340. 3910 IF ShowTime THEN MOVE #60 TO COLOUR0
  341. 3920 MOVE #2 TO BLTCON1 :REMark DESCENDING pass
  342. 3930 IF CharHeight%<>8 THEN MOVE #HEX("59A0") TO BLTCON0
  343. 3940 MOVE #a+c-2 TO BLTAPT+2 :REMark Source
  344. 3950 MOVE #0 TO BLTDPT+2 :REMark Destinationn
  345. 3960 LastCharMove=copper-2 :REMark Last Copper B pointer
  346. 3970 MOVE #c*32+1 TO BLTSIZE
  347. 3980 WAIT 0,0 :REMark Wait for Blit to finish
  348. 3990 END DEFine CHARS_TO_CLIST
  349.